#this file is http://asteriskman.googlecode.com/hg/grooveSharkProxy/grooveSharkProxy.tcl
#we're going to have to catch the http request, parse out the destination host
#find the correct ip and then start the redirection...
#based on the "cross domain policy" xml file that i see we may need to proxy *.grooveshark.com, *.escapemg.com *.svn *.gslite.com
#( http.request.uri contains "stream.php") && ( http.request.method == "POST") && !(ip.dst_host contains "ibm") && !(ip.dst_host contains "facebook")

#todo:
#  1:only save files that have a type of audio/mpeg?
#X 2:keep track of files downloaded so we don't save everything every time something is listened to...using song name info, not md5sum
#  3:send to the system tray on minimize
#  4:flash tray (popup message?) when no file name is found and allow the user to supply the name
#  5:allow user to come and say that the last file was bad in some way so it and it's signature should be deleted
#X 6:save files in a location different than where the app was started
#X 7:Watch more of the communication and determine which machine the song will be requested from so we don't have to have a
#    constant fight when they change their hostnames. I think we need to look for a response from cowbell.grooveshark.com
#    to a /more.php?getStreamKeyFromSongIDEx post. The response will contain JSON which will contain "ip": "hostname". But
#    apparently, cowbell.grooveshark.com also handles SSL requests on port 443 so we'll have to handle that too
#X 8:don't print debug messages except in debug mode
#X 9:allow the user to rename files that have been downloaded

#for zlib
package require Tcl 8.6
package require dns
package require json
#package require md5

source ./id3v2reader.tcl

source ./grooveSharkSSLProxy.tcl

set logWindow "."
proc createLogWindow { lw } {
  global logWindow
  set logWindow $lw
  #toplevel $logWindow
  text .txtLog -font {Courier 10}
  listbox .lFiles -selectmode extended
  button .bRename -text "Rename" -command doRename
  button .bDelete -text "Delete" -command doDelete
  #place .txtLog -relwidth 1.0 -relheight 1.0 -height -20 -x 0 -y 0
  place .txtLog -width 500 -relheight 1.0 -x 0 -y 0
  place .bRename -x 500 -y 0 -width 100 -height 20
  place .bDelete -x 600 -y 0 -width 100 -height 20
  place .lFiles -x 500 -y 20 -relwidth 1.0 -width -500 -relheight 1.0 -height -20

  wm geometry . "800x400"
}

proc log { msg {type normal}} {
  global logWindow
  global debugMode

  switch -- $type {
    normal {
      set fgcolor "#000000"
      set bgcolor "#FFFFFF"
    }
    success {
      set fgcolor "#00FF00"
      set bgcolor "#FFFFFF"
    }
    error {
      set fgcolor "#FF0000"
      set bgcolor "#FFFFFF"
    }
    debug {
      set fgcolor "#E0E0E0"
      set bgcolor "#FFFFFF"
      if {$debugMode == 0} {
        return
      }
    }
    default {
      set fgcolor "#000000"
      set bgcolor "#FFFFFF"
    }
  }

  set maxDataSize 10000
  set maxDataSize 1000000
  set resetSize 8000
  if {[.txtLog count 0.0 end] > $maxDataSize} {
    set newText [string range [.txtLog get 0.0 end] $resetSize end]
    .txtLog delete 0.0 end
    .txtLog insert 0.0 $newText
  }
  .txtLog insert end "$msg\n" colorTag$fgcolor$bgcolor
  .txtLog tag configure colorTag$fgcolor$bgcolor -background $bgcolor -foreground $fgcolor
  .txtLog see end
  update; update idletasks
}

proc binToHex {s} {
  binary scan $s H* hex
  return $hex
}

proc hexToBin {h} {
  return [binary format H* $h]
}

proc init { } {
  global CONFIG

  if {[file exists ./grooveSharkProxy.cfg]} {
    set fd [open ./grooveSharkProxy.cfg "r"]
    while {![eof $fd]} {
      gets $fd line
      if {[string index $line 0] != "#"} {
        foreach {name value} [split $line =] {break}
        set cfgFileInfo($name) $value
      }
    }
    close $fd

  }

  if {[info exists cfgFileInfo(outputDir)] && [file isdirectory $cfgFileInfo(outputDir)]} {
    log "Output directory is $cfgFileInfo(outputDir)"
    set CONFIG(outputDir) $cfgFileInfo(outputDir)
  } else {
    set CONFIG(outputDir) [pwd]
  }


  cleanHostsFile
  addHostsRedirect "grooveshark.com"
  addHostsRedirect "akamai.grooveshark.com"
  addHostsRedirect "cowbell.grooveshark.com"
  addHostsRedirect "listen.grooveshark.com"
  loadPreviousSignatures
  closeServerListeners
  openServerListener 80
  #openServerListener 443
  grooveSharkSSLProxy::openServerListener 443 log
  updateListBox
}

set listeningSockets {}
proc closeServerListeners { } {
  global listeningSockets
  set ls $listeningSockets
  set listeningSockets {}
  foreach s $ls {
    close $s
    log "Closed listener $s" debug
  }
}

proc closeServerInstances { } {
  global serverInstances
  set si $serverInstances
  set serverInstances {}
  foreach s $si {
    closeServerInstance $s
  }
}

proc openServerListener { portNum } {
  global listeningSockets
  set serverSock [socket -server "openServerInstance $portNum" $portNum]
  lappend listeningSockets $serverSock
  log "Listening on port $portNum ($serverSock)" debug
  return $serverSock
}

set serverInstances {}
proc openServerInstance { dstPortNum s srcAddr srcPortNum } {
  global socketInfo CONFIG serverInstances
  log "Connection on $s from $srcAddr : $srcPortNum => $dstPortNum" debug
  set socketInfo($s,dstPortNum) $dstPortNum
  set socketInfo($s,srcAddr) $srcAddr
  set socketInfo($s,srcPortNum) $srcPortNum
  set socketInfo($s,type) local
  set socketInfo($s,buffer) {}

  if {$dstPortNum == 443} {
    set socketInfo($s,state) ssl
  } else {
    set socketInfo($s,state) new
  }


  lappend serverInstances $s

  fconfigure $s         -blocking 0 -buffering none -translation binary

  fileevent $s readable "readSocket $s"

  log "Proxy Established, waiting for request" debug
}

proc getUniqueFilename { base extension } {
  while {1} {
    set num [clock seconds]
    set filename "${base}${num}.${extension}"
    if {![file exists $filename]} {
      return $filename
    }
  }
}

proc readSocket { s } {
  global socketInfo CONFIG
  fileevent $s readable ""
  #set twin $socketInfo($s,twin)
  if {![eof $s] && [info exists socketInfo($s,type)]} {
    set data [read $s]
    #log $data
    switch -exact -- $socketInfo($s,type) {
      "remote" {
        #log "$s got remote data in state $socketInfo($s,state):\n$data"
        if {[string equal $socketInfo($s,state) "new"]} {
          #log $data
          append socketInfo($s,buffer) $data
          set headerEnd [string first "\r\n\r\n" $socketInfo($s,buffer)]
          if {$headerEnd != -1} {
            #log "$socketInfo($s,buffer)"
            #need to check return code
            regexp {HTTP/[0-9.]+ ([0-9]+) .*} $socketInfo($s,buffer) match rcode
            set contentLengthStart [expr "[string first "Content-Length: " $socketInfo($s,buffer)] + 16"]
            set remainderStart [expr {$headerEnd + 4}]
            if {($contentLengthStart == -1) || ([expr {$rcode / 100}] != 2)} {
              set socketInfo($s,state) dataPass
              set contentLength 0
              log [string range $socketInfo($s,buffer) 0 500] debug
              log "New data of length $contentLength bytes => NOFILE" debug
            } else {
              set contentLengthEnd [expr "$contentLengthStart + [string first "\r\n" [string range $socketInfo($s,buffer) $contentLengthStart end]] - 1"]
              set contentLength [string range $socketInfo($s,buffer) $contentLengthStart $contentLengthEnd]
              set contentData [string range $socketInfo($s,buffer) $remainderStart end]
              #log "$socketInfo($s,buffer) LENGTH=$contentLength"
              if {![regexp {Content-Type: ([^\r;]+)} $socketInfo($s,buffer) junk contentType]} {
                set contentType UNKNOWN
              }
              #log "contentLength=$contentLength, contentType=$contentType"
              switch -exact -- $contentType {
                "text/html" {
                  set socketInfo($s,state) dataPass
                  if {[regexp {Content-Encoding: ([^\r]+)} $socketInfo($s,buffer) junk contentEncoding]} {
                    #log "Content-Encoding = \"$contentEncoding\" [binToHex $contentEncoding]   =[string equal $contentEncoding gzip]"
                    if {[string equal $contentEncoding gzip]} {
                      if {[catch {set contentData [zlib gunzip $contentData]} fid]} {
                        #log "unzip error: $fid"
                      } else {
                        #log "unzipped contentData: $contentData"
                      }
                    } else {
                      #log "contentEncoding != gzip"
                    }
                  } else {
                    #log "Content-Encoding = ???"
                  }
                  if {![catch {set json [::json::json2dict $contentData]} fid]} {
                    if {![catch {set newHost [dict get $json result ip]} fid2]} {
                      #we know the name of the next host
                      log "THE NEXT HOSTNAME IS GOING TO BE $newHost" debug
                      addHostsRedirect $newHost
                    }
                  }
                }
                "audio/mpeg" {
                  set socketInfo($s,state) dataFile
                  set filename [getUniqueFilename [file join $CONFIG(outputDir) file] mp3]
                  set socketInfo($s,filename) $filename
                  set fd [open $filename "w"]
                  fconfigure $fd -buffering none -translation binary
                  set socketInfo($s,fd) $fd
                  set socketInfo($s,ContentLength) $contentLength
                  #log [string range $socketInfo($s,buffer) 0 500]
                  log "Starting download of $contentLength bytes => $filename"
                  #now we need to dump the remaining buffer to a file and from now on dump the read data to a file
                  puts -nonewline $fd $contentData
                }
              }
            }
            set socketInfo($s,bytesWritten) [expr "[string length $socketInfo($s,buffer)] - $remainderStart"]
          }
        } elseif {[string equal $socketInfo($s,state) "dataFile"]} {
          #here we dump data into the file
          set remainingBytes [expr {$socketInfo($s,ContentLength) - $socketInfo($s,bytesWritten)}]
          set dataBytes [string length $data]
          if {$dataBytes < $remainingBytes} {
            puts -nonewline $socketInfo($s,fd) $data
            incr socketInfo($s,bytesWritten) $dataBytes
          } else {
            #need to write $remainingBytes to file and then set state back to new
            puts -nonewline $socketInfo($s,fd) [string range $data 0 [expr {$remainingBytes - 1}]]
            close $socketInfo($s,fd)
            set token [id3v2reader::parseFile $socketInfo($s,filename)]
            set bestFilename [id3v2reader::bestFilename $token]
            id3v2reader::cleanup $token
            set signature ${bestFilename}.mp3
            if {([string length $bestFilename] > 0) && [isSignatureFound $signature]} {
              log "File \"$signature\" already downloaded. Deleting" error
              file delete $socketInfo($s,filename)
            } else {
              addSignature $signature
              if {[string length $bestFilename] > 0} {
                set displayName "${bestFilename}.mp3"
                set newName [file join [file dirname $socketInfo($s,filename)] $displayName]
                if {[file exists $newName]} {
                  set newName [getUniqueFilename [file join [file dirname $socketInfo($s,filename)] $bestFilename] mp3]
                }
                file rename $socketInfo($s,filename) $newName
              } else {
                set displayName $socketInfo($s,filename)
              }
              log "Finished downloading \"$displayName\" ($socketInfo($s,ContentLength) bytes)" success
              updateListBox
            }
            set socketInfo($s,buffer) [string range $data $remainingBytes end]
            set socketInfo($s,state) new
          }
        }
        #if we're in ssl mode we should get this far and just dump our data out
        set twin $socketInfo($s,twin)
        if {[string equal $socketInfo($s,state) "ssl"]} {
          #log "$s got ssl data from server, sending to client:\n[binToHex [string range $data 0 100]]"
          #log "$s got ssl data from server, sending to client:\n$data"
        }
        if {[catch {puts -nonewline $twin $data} fid]} {
          closeServerInstance $s
          closeServerInstance $twin
        } else {
          fileevent $s readable "readSocket $s"
        }
      }
      "local" {
        #log "$s Data from local client in state $socketInfo($s,state):\n[binToHex $data]"
        #log "$s Data from local client in state $socketInfo($s,state):\n$data"
        if {[string equal $socketInfo($s,state) "new"]} {
          append socketInfo($s,buffer) $data
          #global testdata
          #set testdata $socketInfo($s,buffer)
          if {[regexp {Host: ([^\r\n]+)\r\n} $socketInfo($s,buffer) junk hostname]} {
            #ready to make connection
            log "Connecting to $hostname" debug

            set dstSocket [socket [getHostIP $hostname] $socketInfo($s,dstPortNum)]
            set socketInfo($dstSocket,dstPortNum) $socketInfo($s,dstPortNum)
            set socketInfo($dstSocket,srcAddr) localhost
            set socketInfo($dstSocket,srcPortNum) [fconfigure $dstSocket -sockname]
            set socketInfo($dstSocket,type) remote
            set socketInfo($dstSocket,state) new
            set socketInfo($dstSocket,buffer) {}

            global serverInstances
            lappend serverInstances $dstSocket
            set socketInfo($s,twin) $dstSocket
            set socketInfo($dstSocket,twin) $s
            set twin $dstSocket

            fconfigure $dstSocket -blocking 0 -buffering none -translation binary
            fileevent $dstSocket readable "readSocket $dstSocket"

            set $socketInfo($s,state) "connected"
            if {[catch {puts -nonewline $twin $socketInfo($s,buffer)} fid]} {
              closeServerInstance $s
              closeServerInstance $twin
            } else {
              set socketInfo($s,buffer) {}
              fileevent $s readable "readSocket $s"
            }
          }
        } elseif {[string equal $socketInfo($s,state) "ssl"]} {
          set hostname "cowbell.grooveshark.com"
          log "$s Connecting to $hostname SSL" debug
          set dstSocket [socket [getHostIP $hostname] $socketInfo($s,dstPortNum)]
          set socketInfo($dstSocket,dstPortNum) $socketInfo($s,dstPortNum)
          set socketInfo($dstSocket,srcAddr) localhost
          set socketInfo($dstSocket,srcPortNum) [fconfigure $dstSocket -sockname]
          set socketInfo($dstSocket,type) remote
          set socketInfo($dstSocket,state) ssl
          global serverInstances
          lappend serverInstances $dstSocket
          set socketInfo($s,twin) $dstSocket
          set socketInfo($dstSocket,twin) $s
          set twin $dstSocket

          fconfigure $dstSocket -blocking 0 -buffering none -translation binary
          fileevent $dstSocket readable "readSocket $dstSocket"

          set $socketInfo($s,state) "connected"
          if {[catch {puts -nonewline $twin $data} fid]} {
            closeServerInstance $s
            closeServerInstance $twin
          } else {
            fileevent $s readable "readSocket $s"
            #log "$s sent client ssl data to server $dstSocket and ready for reply [string length $data]"
          }
        } else {
          #this should be when we're in the "connected" state and we just dump out the data
          set twin $socketInfo($s,twin)
          #log "$s Sending data to server in state $socketInfo($s,state):\n[binToHex $data]"
          #log "$s Sending data to server in state $socketInfo($s,state):\n$data"
          if {[catch {puts -nonewline $twin $data} fid]} {
            closeServerInstance $s
            closeServerInstance $twin
          } else {
            fileevent $s readable "readSocket $s"
          }
        }
      }
    }
   #if {[catch {puts -nonewline $twin $data} fid]} {
   #  closeServerInstance $s
   #  closeServerInstance $twin
   #} else {
   #  fileevent $s readable "readSocket $s"
   #}
  } else {
    if {[info exists $socketInfo($s,twin)]} {
      closeServerInstance $socketInfo($s,twin)
    }
    closeServerInstance $s
  }
}

proc closeServerInstance { s } {
  global socketInfo
  catch {fileevent $s readable ""}
  catch {close $s}
  catch {close $socketInfo($s,fd)}
  array unset socketInfo "$s,*"
}

proc getHostIP {hostname} {
  set token [dns::resolve $hostname]
  dns::wait $token
  set ip [dns::address $token]
  dns::cleanup $token
  return [lindex $ip 0]
}

proc addHostsRedirect {hostname} {
  global CONFIG
  if {![info exists CONFIG(redirectHostnames,$hostname)]} {
    set filename "c:/windows/system32/drivers/etc/hosts"
    set fd [open $filename "a+"]
    puts $fd "127.0.0.1 $hostname #grooveSharkProxy.tcl"
    close $fd
    set CONFIG(redirectHostnames,$hostname) 1
  }
}

proc cleanHostsFile { } {
  set filename "c:/windows/system32/drivers/etc/hosts"
  set tempFilename ${filename}.tmp

  log "Removing redirect to localhost" debug

  #remove grooveshark redirection from hosts file
  set fdIn [open $filename "r"]
  set fdOut [open $tempFilename "w"]
  while {![eof $fdIn]} {
    gets $fdIn line
    if {[string length $line] != 0} {
      if {![string match "*#grooveSharkProxy.tcl*" $line]} {
        puts $fdOut $line
      }
    }
  }
  close $fdIn
  close $fdOut
  file rename -force $tempFilename $filename
}

proc fixFileName {fn} {
  set t [id3v2reader::parseFile $fn]
  set bestName [id3v2reader::bestFilename $t]
  id3v2reader::cleanup $t
  set finalName $fn
  if {[string length $bestName] > 0} {
    if {![string equal $fn ${bestName}.mp3]} {
      if {![file exists ${bestName}.mp3]} {
        file rename $fn ${bestName}.mp3
        set finalName ${bestName}.mp3
      } else {
        set bestFullName [getUniqueFilename $bestName mp3]
        file rename $fn $bestFullName
        set finalName $bestFullName
      }
    }
  }
  return $finalName
}

proc loadPreviousSignatures { } {
  global signatures
  if {[file readable fileSignatures.dat]} {
    set fd [open fileSignatures.dat "r"]
    set data [read $fd]
    close $fd
    set signatures [split $data "\n"]
    if {[llength $signatures] > 0 && [regexp {[A-F0-9]{32}} [lindex $signatures 0]]} {
      #need to rename everything and then put the new names as the new signature file
      file delete fileSignatures.dat
      set signatures {}
      foreach f [glob -nocomplain *.mp3] {
        set newFileName [fixFileName $f]
        addSignature $newFileName
      }
    }
  } else {
    set signatures {}
  }
}

proc addSignature {s} {
  global signatures
  lappend signatures $s
  set fd [open fileSignatures.dat "a"]
  puts $fd $s
  close $fd
}

proc isSignatureFound {s} {
  global signatures
  if {[string length $s] == 0} { return 0 }
  if {[lsearch -exact $signatures $s] == -1} {
    return 0
  } else {
    return 1
  }
}

proc updateListBox { } {
  global CONFIG
  #CONFIG(outputDir)
  set fileList [glob -nocomplain -dir $CONFIG(outputDir) *]
  #sort the files by creation date
  foreach file $fileList {
    lappend fileSortList [list $file [file mtime $file]]
  }
  set fileSortList [lsort -index 1 -integer -increasing $fileSortList]
  .lFiles delete 0 end
  foreach file $fileSortList {
    .lFiles insert 0 [file tail [lindex $file 0]]
  }
}

proc doRename { } {
  global CONFIG
  set curSelection [.lFiles curselection]
  if {[llength $curSelection] != 1} {
    log "You can only rename 1 file at a time." error
    return
  }
  set oldFilename [.lFiles get $curSelection]
  set newFilename [tk_getSaveFile -initialdir $CONFIG(outputDir) -initialfile $oldFilename -title "Rename As"]
  if {[string length $newFilename] > 0} {
    file rename [file join $CONFIG(outputDir) $oldFilename] $newFilename
  }
  updateListBox
}

proc doDelete { } {
  global CONFIG
  set curSelection [.lFiles curselection]
  set answer [tk_messageBox -message "Are you sure you want to delete [llength $curSelection] files?" -icon warning -title "Delete?" -type yesno -default "no"]
  if {[string equal $answer "yes"]} {
    foreach sel $curSelection {
      file delete [file join $CONFIG(outputDir) [.lFiles get $sel]]
    }
  }
  updateListBox
}

if {![info exists GUILOADED]} {
  set GUILOADED true
  createLogWindow ""
  set sourceFile [info script]
  log "Welcome to grooveSharkProxy.tcl"
  bind . <F5> {log "Reloading $sourceFile"; source $sourceFile}
  bind . <F1> {source ../attachConsole.tcl}
  bind . <F2> {set debugMode [expr {!$debugMode}]; log "debugMode=$debugMode"}
  update idletasks; update
}

set debugMode 1

wm protocol . WM_DELETE_WINDOW "closeServerListeners; grooveSharkSSLProxy::closeServerListeners; cleanHostsFile; exit"

init

set debugMode 0

